home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / src / cmds / scvs / scvs.mary < prev    next >
Encoding:
Text File  |  1991-10-31  |  49.4 KB  |  2,200 lines
  1. #! /sprite/cmds/perl 
  2. #
  3. #   Scvs is the "Sprite Concurrent Version System", pronounced "skivies".
  4. #   It is a Perl script wrapper for cvs.  See the cvs man page for more
  5. #   details.
  6. #
  7. # $Header: /local/src/cmds/scvs/RCS/scvs,v 1.10 91/10/08 17:21:06 jhh Exp $ SPRITE (Berkeley)
  8. #
  9. # Copyright 1991 Regents of the University of California
  10. # Permission to use, copy, modify, and distribute this
  11. # software and its documentation for any purpose and without
  12. # fee is hereby granted, provided that this copyright
  13. # notice appears in all copies.  The University of California
  14. # makes no representations about the suitability of this
  15. # software for any purpose.  It is provided "as is" without
  16. # express or implied warranty.
  17. #
  18.  
  19. require "option.pl";
  20. require "pwd.pl";
  21. require "ctime.pl";
  22. require "stat.pl";
  23.  
  24. $recurse = 1;                # A John Hartman special word.
  25. $verbose = 0;
  26. $linkFile = "links";
  27. $debug = 0;
  28. $configFile = "SCVS.config";
  29. $argFile = "args";
  30. $modNameFile = "moduleName";
  31. $userFile = "SCVS/users";
  32. $installOp = 0;
  33.  
  34. @options = (
  35.     $OPT_NIL, $OPT_DOC, $OPT_NIL, 
  36.     "Usage: scvs [scvs options] command [command options]",
  37.     "V", $OPT_TRUE, *verbose, "Verbose",
  38.     "D", $OPT_TRUE, *debug, "Debug",
  39.     "r", $OPT_FUNC, "CvsOpt1", "Check out files read-only",
  40.     "w", $OPT_FUNC, "CvsOpt1", "Check out files read-write (default)",
  41.     "v", $OPT_FUNC, "CvsOpt1", "Print cvs version info",
  42.     "d", $OPT_STRING, *cvsroot, "Specify cvs root directory",
  43.     "e", $OPT_FUNC, "CvsOpt1", "Specify editor to use",
  44.     "H", $OPT_FUNC, "CvsOpt1", "Print help information",
  45. );
  46. undef($cvsargs);
  47. &Opt_Parse(*ARGV, @options, $OPT_OPTIONS_FIRST);
  48. if ($debug) {
  49.     $verbose = 1;
  50. }
  51. $cvsCmdArgs = $cvsargs;
  52.  
  53. @cvsCmds = ("join", "patch", "tag");
  54.  
  55.  
  56. #
  57. # Config
  58. #
  59. # Find the configuration file and set up various configuration variables.
  60. #
  61. # Results: 0 if successful, 1 otherwise
  62. # 
  63. # Side effects: Some variables are set.
  64. #
  65.  
  66. sub Config {
  67.     local($pwd) = $ENV{'PWD'};
  68.     local($stat, $lastStat) = (0, 0);
  69.     local($tmp);
  70.     local(@attempts);
  71.  
  72.     #
  73.     # Work our way up the directory tree looking for the config file.
  74.     #
  75.     while(! -e $configFile) {
  76.     push(@attempts, $ENV{'PWD'});
  77.     &Chdir("..") == 0 || return 1;
  78.     &Stat(".");
  79.     $stat = $st_dev . $st_ino . $st_serverID;
  80.     last if ($stat eq $lastStat);
  81.     $lastStat = $stat;
  82.     }
  83.     if (! -e $configFile) {
  84.     printf("Couldn't find configuration file\n");
  85.     foreach $tmp (@attempts) {
  86.         printf("Not in $tmp\n");
  87.     }
  88.     return 1;
  89.     }
  90.     open(CONFIG, "$configFile") || die("Can't open $configFile: $!\n");
  91.     while(<CONFIG>) {
  92.     next if (/^\s*#/);
  93.     if (/^cvsroot:\s+(\S+)\s*$/) {
  94.         if (!defined($cvsroot)) {
  95.         $cvsroot = $1;
  96.         }
  97.     } elsif(/^installdir:\s+(\S+)\s*$/) {
  98.         $installdir = $1;
  99.     }
  100.     }
  101.     close(CONFIG);
  102.     if (!defined($cvsroot)) {
  103.     printf("cvsroot not set in config file\n");
  104.     return 1;
  105.     }
  106.     &Chdir("$pwd") == 0 || return 1;
  107.     return 0;
  108. }
  109.  
  110. #
  111. # PackCmd($command, @dirs)
  112. #
  113. # Runs a Pack or Unpack command on each of the directories in the list.
  114. #
  115. # Results: 0 if successful, 1 otherwise
  116. #
  117. # Side effects:  The link file is modified.
  118. #
  119.  
  120. sub PackCmd {
  121.     local($command) = shift;
  122.     local(@dirs) = @_;
  123.     local($status) = 0;
  124.     local($pwd) = $ENV{'PWD'};
  125.  
  126.     if ($#dirs < $[) {
  127.     push(@dirs, '.');
  128.     }
  129.     foreach $dir (@dirs) {
  130.     &Chdir($dir) == 0 || return 1; 
  131.     if ($command eq "pack") {
  132.         $status = &Pack($dir);
  133.     } else {
  134.         $status = &Unpack($dir);
  135.     }
  136.     if ($status) {
  137.         return $status;
  138.     }
  139.     &Chdir($pwd) == 0 || return 1; 
  140.     }
  141. }
  142. #
  143. # Pack($path)
  144. #
  145. # Finds all symbolic links in the current directory and puts them in the
  146. # link file.  The links are stored in alphabetical
  147. # order.  If $recurse is non-zero, Pack will call itself to recurse on
  148. # subdirectories.
  149. #
  150. # Results: 0 if successful, 1 otherwise
  151. #
  152. # Side effects: The link file is modified.
  153. #
  154.  
  155. sub Pack {
  156.     local($path) = shift;
  157.     local($addDir) = 0;
  158.     local($addFile) = 0;
  159.     local(%links);
  160.     local($link);
  161.  
  162.     #
  163.     # Don't pack SCVS subdirectories.
  164.     #
  165.     if ($path =~ m|.*/SCVS|) {
  166.     return 0;
  167.     }
  168.     printf(STDERR "Packing $path\n") if ($debug);
  169.     $addDir = (-d "SCVS") ? 0 : 1;
  170.     $addFile = (-f "SCVS/$linkFile") ? 0 : 1;
  171.     opendir(THISDIR, ".") || return &Error(1, "Opendir of $path failed: $!\n");
  172.     foreach $link (grep(-l, readdir(THISDIR))) {
  173.     printf(STDERR "$link\n") if ($debug);
  174.     $links{$link} = readlink($link);
  175.     }
  176.     close(THISDIR);
  177.     if (defined(%links) || (!$addFile)) {
  178.     if ($addDir) {
  179.         mkdir("SCVS", 0770) ||
  180.         return &Error(1, "Mkdir of SCVS failed: $!\n");
  181.     }
  182.     if (open(PACK, ">SCVS/$linkFile") == 0) {
  183.         printf("Can't open $linkFile: $!\n");
  184.         $status = 1;
  185.         last;
  186.     }
  187.     printf(PACK 
  188.         "# This file is used by scvs and contains symbolic link\n");
  189.     printf(PACK 
  190.         "# information.  Each line is of the form \"link target\"\n");
  191.     printf(PACK "# \$Header\n");
  192.     foreach $link (sort keys %links) {
  193.         printf(PACK "%-24s %s\n", $link, $links{$link});
  194.     }
  195.     close(PACK);
  196.     if ($addFile && (-e "CVS.adm")) {
  197.         if ($addDir) {
  198.         system("cvs -d $cvsroot add SCVS");
  199.         }
  200.         system("cvs -d $cvsroot add -m\"scvs links\" SCVS/$linkFile");
  201.     }
  202.     } 
  203.     if ($recurse) {
  204.     $status = &AllSubdirs($path, "Pack");
  205.     }
  206.     return $status;
  207. }
  208.  
  209. #
  210. # Unpack($path)
  211. #
  212. # Reads the link file in the current directory and creates symbolic links
  213. # from its contents. If recurse is non-zero, Unpack will call itself to 
  214. # recurse on subdirectories.
  215. #
  216. # Results: 0 if successful, 1 otherwise
  217. #
  218. # Side effects: Symbolic links may be created in the current directory
  219. #
  220. sub Unpack {
  221.     local($path) = shift;
  222.     local($status) = 0;
  223.  
  224.     printf(STDERR "Unpacking $path\n") if ($debug);
  225.     if (open(UNPACK, "SCVS/$linkFile")) {
  226.     while(<UNPACK>) {
  227.         next if (/^#/);
  228.         if (/(\S+)\s+(\S+)/) {
  229.         ($link, $value) = ($1, $2);
  230.         if (-l $link) {
  231.             $old = readlink($link);
  232.             if ($old ne $value) {
  233.             printf(
  234.             "Changing $link -> $value, instead of -> $old\n");
  235.             unlink($link);
  236.             } else {
  237.             next;
  238.             }
  239.         } elsif (-e $link) {
  240.             printf("File $link already exists.\n");
  241.             $status = 1;
  242.             next;
  243.         } elsif ($verbose) {
  244.             printf("Creating: $link -> $value\n");
  245.         }
  246.         if (symlink($value, $link) == 0) { 
  247.             printf("Can't create link from $link to $value: $!");
  248.             $status = 1;
  249.         }
  250.         }
  251.     }
  252.     close(UNPACK);
  253.     }
  254.     if ($recurse) {
  255.     $status = &AllSubdirs($path, "Unpack");
  256.     }
  257.     return $status;
  258. }
  259.  
  260. #
  261. # Repository(module)
  262. #
  263. # Finds the pathname of the repository directory for the given module.
  264. #
  265. # Results: The pathname
  266. #
  267. # Side effects: 
  268. #
  269.  
  270. sub Repository {
  271.     local($tmp);
  272.     $tmp = &ReadFile("$_[0]/CVS.adm/Repository", 1);
  273.     if (defined($tmp)) {
  274.     chop($tmp);
  275.     return "$cvsroot/$tmp"; 
  276.     }
  277.     return undef;
  278. }
  279.  
  280. #
  281. # Prune($path)
  282. #
  283. # Removes the given directory if it is empty (no user files or subdirectories).
  284. # Recurses on subdirectories.
  285. #
  286. # Results: 0 if successful, 1 otherwise
  287. #
  288. # Side effects: The directory or its subdirectories may be removed.
  289. #
  290.  
  291. sub Prune {
  292.     local($path) = shift;
  293.     local($i);
  294.     local($status) = 0;
  295.     local($empty) = 1;
  296.     local($tail) = substr($path, rindex($path, '/') + 1);
  297.  
  298.     if ($tail eq "SCVS") {
  299.     return 0;
  300.     }
  301.     print "Pruning $path\n" if ($debug);
  302.     $status = &AllSubdirs($path, "Prune");
  303.     if ($status) {
  304.     return $status;
  305.     }
  306.     opendir(THISDIR, ".") || 
  307.     return &Error(1, "Opendir of $path failed: $!\n"); 
  308.     foreach $i (readdir(THISDIR)) {
  309.     next if ($i eq ".");
  310.     next if ($i eq "..");
  311.     next if ($i eq "CVS.adm");
  312.     next if ($i eq "SCVS");
  313.     print "Found $i in $path\n" if ($debug);
  314.     $empty = 0;
  315.     last;
  316.     }
  317.     close(THISDIR);
  318.     if ($empty) {
  319.     print "Prune: chdir to ..\n" if ($debug);
  320.     &Chdir("..") == 0 || return 1;
  321.     print "Prune: deleting $tail\n" if ($debug);
  322.     system("rm -rf $tail");
  323.     }
  324.     return 0;
  325. }
  326.  
  327. #
  328. # CvsOpt1($optString, $nextArg)
  329. #
  330. # Appends $optString to $cvsargs.
  331. #
  332. # Results: 0 
  333. #
  334. # Side effects: None
  335. #
  336. sub CvsOpt1 {
  337.     printf("CvsOpt1 @_\n") if ($debug);
  338.     $cvsargs .= "$_[0] ";
  339.     return 0;
  340. }
  341.  
  342. #
  343. # CvsOpt2($optString, $nextArg)
  344. #
  345. # Appends $optString and $nextArg to $cvsargs.
  346. #
  347. # Results: 1
  348. #
  349. # Side effects: None
  350. #
  351. sub CvsOpt2 {
  352.     printf("CvsOpt2 @_\n") if ($debug);
  353.     $cvsargs .= "$_[0] \"$_[1]\" ";
  354.     return 1;
  355. }
  356.  
  357.  
  358. #
  359. # Checkout(@modules)
  360. #
  361. # Checks out modules.  "cvs co" is used to make a copy of the module. 
  362. # Unpack is used to unpack symbolic links.  
  363. # The current user name is added to the SCVS.users
  364. # file and a list of any other users with a copy of the module are 
  365. # printed.  Any options passed to "cvs co" are stored in the SCVS/args
  366. # file to be used on subsequent updates.
  367. #
  368. # Results: 0 if successful, 1 otherwise
  369. #
  370. # Side effects: A subdirectory is created for each module.
  371. #
  372.  
  373. sub Checkout {
  374.     local(@modules) = @_;
  375.     local($buffer, $i,$repos, $user, $date, %count, %dates);
  376.     local($found, $name);
  377.     local($prune) = 1;
  378.     local($personal) = 0;
  379.     local($args);
  380.     local(@options) = ( 
  381.     "l", $OPT_FALSE, *recurse, "Don't recurse.",
  382.     "P", $OPT_FALSE, *prune, "Don't prune empty directories.",
  383.     "i", $OPT_TRUE, *personal, "Deviation from standard source tree",
  384.     "f", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  385.     "c", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  386.     "Q", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  387.     "q", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  388.     "f", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  389.     "n", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  390.     "p", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  391.     "r", $OPT_FUNC, "CvsOpt2", $OPT_NULL,
  392.     "D", $OPT_FUNC, "CvsOpt2", $OPT_NULL,
  393.      );
  394.  
  395.     undef($cvsargs);
  396.     &Opt_Parse(*modules, @options, $OPT_OPTIONS_FIRST | $OPT_NO_SPACE);
  397.     $args = $cvsargs;
  398.  
  399.     # Put together the "cvs co" command.
  400.  
  401.     $buffer = "cvs -d $cvsroot $cvsCmdArgs co $args";
  402.  
  403.     if ($args =~ /-c/) {
  404.     system("$buffer");
  405.     return 0;
  406.     }
  407.    if (($args =~ /-r/) || ($args =~ /-D/)) {
  408.     $buffer .= "-f ";
  409.     }
  410.     $status = &Lock("r", @modules);
  411.     if ($status) {
  412.     return $status;
  413.     }
  414.     $user = getlogin;
  415.     print "@modules\n" if ($debug);
  416.  
  417. module:
  418.     foreach $i (@modules) {
  419.     local($pwd) = $ENV{'PWD'};
  420.  
  421.     printf("Checking out $i\n") if ($debug);
  422.     # Perform the "cvs co".
  423.  
  424.     printf("$buffer $i \n") if ($debug);
  425.     system("$buffer $i");
  426.  
  427.     # Store the "cvs co" arguments in the info file.
  428.  
  429.     if (! -d "$i/SCVS") {
  430.         if (!mkdir("$i/SCVS", 0770)) {
  431.         $status = &Error(1, "Mkdir of $i/SCVS failed: $!\n");
  432.         next module;
  433.         }
  434.     }
  435.     if (!open(CO, ">$i/SCVS/$argFile")) {
  436.         $status = &Error(1, "Open of $i/SCVS/$argFile failed: $!\n");
  437.         next module;
  438.     }
  439.     print(CO "# This file contains the arguments given when this\n");
  440.     print(CO "# module was checked out.\n");
  441.     print(CO "$cvsCmdArgs\n");
  442.     print(CO "$args\n");
  443.     close(CO);
  444.  
  445.     &Chdir($i) == 0 || return 1; 
  446.  
  447.     # Unpack the module.
  448.     &Unpack($i) == 0 || return &Error("Unpack of $i failed\n");
  449.  
  450.     # Prune any empty directories in the module.
  451.     if ($prune) {
  452.         &Prune($i) == 0 || return &Error(1, "Prune of $i failed\n");
  453.     }
  454.  
  455.     &Chdir($pwd) == 0 || return 1; 
  456.  
  457.     # See if any other users have a copy of the module, and add our
  458.     # own entry.
  459.  
  460.     $repos = &Repository($i);
  461.     next module if (!defined($repos));
  462.     $date = &ctime(time);
  463.     open(CO2, ">$repos/$tmpfile") ||
  464.         return &Error(1, "Open of $repos/$tmpfile failed: $!\n");
  465.     if (-e "$repos/$userFile") {
  466.         local($copy) = 0;
  467.         open(CO1, "$repos/$userFile") ||
  468.         return &Error(1, "Open of $repos/$userFile failed: $!\n");
  469.         while(<CO1>) {
  470.         $copy = 0;
  471.         next if (/^#/);
  472.         if (/^$user\s+([\w\/\.]+)\s+(.*)/) {
  473.             if ($1 eq "$pwd/$i") {
  474.             $copy = 1;
  475.             } else {
  476.             $found = 1;
  477.             push(@mine, $_);
  478.             }
  479.         } elsif (/^(\S+)\s+([\w\/\.]+)\s+(.*)/) {
  480.             $others{$1} = $3;
  481.         }
  482.         }
  483.         continue {
  484.         if (!$copy) {
  485.             print CO2 $_;
  486.         }
  487.         }
  488.         close(CO1);
  489.     } else {
  490.         printf(CO2 "# List of users with copies of this module.\n");
  491.     }
  492.     if ($#mine >= $[) {
  493.         printf("\nYou also have these copies of the $i module:\n");
  494.         print join("\n", @mine);
  495.     }
  496.     printf(CO2 "$user $pwd/$i %s", &ctime(time));
  497.     close(CO2);
  498.     if (!$personal) {
  499.         if (!rename("$repos/$tmpfile", "$repos/$userFile")) {
  500.         printf(
  501.           "Rename of $repos/$tmpfile to $repos/$userFile failed:$!\n");
  502.         unlink("$repos/$tmpfile");
  503.         next module;
  504.         }
  505.     } else {
  506.         unlink("$repos/$tmpfile");
  507.     }
  508.     if (defined(%others)) {
  509.         printf("\nThe following users have copies of the $i module:\n"); 
  510.         while(($name, $date) = each(%others)) {
  511.         printf("$name $date\n");
  512.         }
  513.     }
  514.     }
  515.     return 0;
  516. }
  517.  
  518. #
  519. # UnlockCmd(@ARGV)
  520. #
  521. # Parse arguements, then call Unlock to do the dirty work. 
  522. #
  523. # Results: 0 if successful, 1 otherwise
  524. #
  525. # Side effects: 
  526. #
  527. sub UnlockCmd {
  528.     local(@args) = @_;
  529.     local($all) = 0;
  530.     local($status) = 0;
  531.     local(@options) = (
  532.     "a", $OPT_TRUE, *all, "Remove everybody's locks",
  533.     );
  534.     &Opt_Parse(*args, @options, $OPT_OPTIONS_FIRST);
  535.     $status = &Unlock($all,@args);
  536.     return $status;
  537. }
  538.  
  539.  
  540. #
  541. # Unlock($allusers, @modules)
  542. #
  543. # Remove the locks for a list of modules.  
  544. #
  545. # Results: 0 if successful, 1 otherwise
  546. #
  547. # Side effects: 
  548. #
  549.  
  550. sub Unlock {
  551.     local($allusers) = shift;
  552.     local(@modules) = @_;
  553.     local($cvsdir, $i, $lock);
  554.     local($status) = 0;
  555.     local($user) = getlogin;
  556.  
  557.     print("Unlock $allusers @modules\n") if ($debug);
  558.     if (!defined(%modMap)) {
  559.     &ModMap;
  560.     }
  561.     if ($#modules < $[) {
  562.     push(@modules, ".");
  563.     }
  564. module:
  565.     foreach $i (@modules) {
  566.     if ($i eq ".") {
  567.         $i = &GetModuleName;
  568.         if (!defined($i)) {
  569.         $status = 1;
  570.         next module;
  571.         }
  572.     }
  573.     if (!defined($modMap{$i})) {
  574.         printf(STDERR "Module $i does not exist.\n");
  575.         $status = 1;
  576.         next module;
  577.     }
  578.     $cvsdir = "$cvsroot/$modMap{$i}/SCVS";
  579.     $lock = "$cvsdir/locks";
  580.     if (!-e $lock) {
  581.         next module;
  582.     }
  583.     if ($allusers) {
  584.         if (!unlink($lock)) {
  585.         printf("Can't remove lock file $lock: $!\n");
  586.         }
  587.         next module;
  588.     }
  589.     if (!open(UNLOCK1, "$lock")) {
  590.         print("Open of $lock failed: $!\n");
  591.         next module;
  592.     }
  593.     if (!open(UNLOCK2, ">$cvsdir/$tmpfile")) {
  594.         print("Open of $cvsdir/$tmpfile failed: $!\n");
  595.         next module;
  596.     }
  597.     flock(UNLOCK1, 2) || 
  598.         return &Error(1, "Flock(2) of $lock failed: $!\n");
  599.  
  600.     while(<UNLOCK1>) {
  601.         ($type, $name) = split(' ');
  602.         if ($name ne $user) {
  603.         print(UNLOCK2 $_);
  604.         }
  605.     }
  606.     close(UNLOCK2);
  607.     if (!rename("$cvsdir/$tmpfile", "$lock")) {
  608.         printf(
  609.           "Rename of $cvsdir/$tmpfile to $lock failed:$!\n");
  610.         unlink("$cvsdir/$tmpfile");
  611.         next module;
  612.     }
  613.     }
  614.     return $status;
  615. }
  616.  
  617. #
  618. # LockCmd(@ARGV)
  619. #
  620. # Parse any options then call Lock to do all the work.
  621. #
  622. # Results: 0 if successful, 1 otherwise
  623. #
  624. # Side effects: The lock files in the modules are updated.
  625. #
  626.  
  627. sub LockCmd {
  628.     local(@args) = @_;
  629.     local($write) = 1;
  630.     local($status) = 0;
  631.     local(@options) = (
  632.     "w", $OPT_TRUE, *write, "Write (exclusive) lock",
  633.     "r", $OPT_FALSE, *write, "Read (shared) lock",
  634.     );
  635.     print("LockCmd @args\n") if ($debug);
  636.     &Opt_Parse(*args, @options, $OPT_OPTIONS_FIRST);
  637.     $status = &Lock($write ? "w" : "r", @args);
  638.     undef(@locks);
  639.     return $status;
  640. }
  641.  
  642.  
  643. #
  644. # Lock($type, @modules)
  645. #
  646. # Make sure the modules are unlocked, and lock them.  Any modules that
  647. # we lock are put in the @lock array.  
  648. #
  649. # Results: 0 if successful, 1 otherwise
  650. #
  651. # Side effects: Lock files are created in the modules.
  652. #
  653.  
  654. sub Lock {
  655.     local($type) = shift;
  656.     local(@modules) = @_;
  657.     local($cvsdir);
  658.     local($status) = 0;
  659.     local($i, $name);
  660.     local(@mylocks);
  661.     local($user) = getlogin;
  662.     local(@lockFiles);
  663.     local($prevType);
  664.     local($prevName);
  665.     local($prevDate);
  666.     local(@prevLocks);
  667.     local($lock);
  668.  
  669.     print("Lock $type @modules\n") if ($debug);
  670.     if (!defined(%modMap)) {
  671.     &ModMap;
  672.     }
  673.     if ($#modules < $[) {
  674.     push(@modules, ".");
  675.     }
  676. module:
  677.     foreach $i (@modules) {
  678.     if ($i eq ".") {
  679.         $i = &GetModuleName;
  680.         if (!defined($i)) {
  681.         $status = 1;
  682.         next module;
  683.         }
  684.     }
  685.     if (!defined($modMap{$i})) {
  686.         printf(STDERR "$i module does not exist.\n");
  687.         $status = 1;
  688.         next module;
  689.     }
  690.     $cvsdir = "$cvsroot/$modMap{$i}/SCVS";
  691.     $lock = "$cvsdir/locks";
  692.     print("Cvsdir = $cvsdir\n") if ($debug);
  693.     if (-f "$lock") {
  694.         print("Opening $lock\n") if ($debug);
  695.         open(LOCK1, "$lock") || 
  696.         return &Error(1, "Open of $lock failed: $!\n");
  697.         flock(LOCK1, 2) || 
  698.         return &Error(1, "Flock(2) of $lock failed: $!\n");
  699.         while(<LOCK1>) {
  700.         ($prevType, $prevName) = split(' ');
  701.         if ($prevName eq $user) {
  702.             if ($prevType ne $type) {
  703.             return &Error(1, "$i already locked:\n$_");
  704.             } else {
  705.             close(LOCK1);
  706.             next module;
  707.             }
  708.         } else {
  709.             if (($prevType eq "r") && ($type eq "w")) {
  710.             return &Error(1, "$i already locked:\n$_");
  711.             } elsif ($prevType eq "w") {
  712.             return &Error(1, "$i already locked:\n$_");
  713.             }
  714.         }
  715.         push(@prevLocks, $_);
  716.         }
  717.     }
  718.     open(LOCK2, ">$cvsdir/$tmpfile") ||
  719.         return &Error(1, "Open of $cvsdir/$tmpfile failed: $!\n");
  720.     foreach $i (@prevLocks) {
  721.         print(LOCK2 "$i");
  722.     }
  723.     printf(LOCK2 "$type $user %s", &ctime(time));
  724.     close(LOCK2);
  725.     if (!rename("$cvsdir/$tmpfile", "$lock")) {
  726.         printf(
  727.           "Rename of $cvsdir/$tmpfile to $lock failed:$!\n");
  728.         unlink("$cvsdir/$tmpfile");
  729.         return 1;
  730.     }
  731.     push(@mylocks, $i);
  732.     close(LOCK1);
  733.     }
  734.     if ($status) {
  735.     if (&Unlock(0, @mylocks)) {
  736.         return &Error(1, "Can't clean up in LockCmd\n");
  737.     }
  738.     }
  739.     push(@locks, @mylocks);
  740.     return $status;
  741. }
  742.  
  743. #
  744. # UpdateCmd($lock, @names)
  745. #
  746. # Update modules.  If the arguments are a list of subdirectories then
  747. # we chdir to each of them and run "cvs update".  If the arguments are
  748. # a list of files then we pass them to cvs.  If no files or directories
  749. # are specified then we update the current directory.  The arguments
  750. # for update are retrieved from the SCVS/args file.
  751. #
  752. # Results: 0 if successful, 1 otherwise
  753. #
  754. # Side effects: 
  755. #
  756.  
  757. sub UpdateCmd {
  758.     local($lock) = shift;
  759.     local(@names) = @_;
  760.     local($buffer, $i, $cvsdir, $date, %count, %dates);
  761.     local($found, $name);
  762.     local($module);
  763.     local($pwd);
  764.     local($tmp);
  765.     local($prune);
  766.     local($buildDirs) = 1;
  767.     local($args);
  768.     local(@options) = ( 
  769.     "B", $OPT_FALSE, *buildDirs, "Don't create new directories.",
  770.     "l", $OPT_FALSE, *recurse, "Don't recurse on subdirs",
  771.     "Q", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  772.     "q", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  773.     "f", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  774.     "n", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  775.     "p", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  776.     "d", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  777.     "r", $OPT_FUNC, "CvsOpt2", $OPT_NULL,
  778.     "D", $OPT_FUNC, "CvsOpt2", $OPT_NULL,
  779.     );
  780.  
  781.     undef($cvsargs);
  782.     &Opt_Parse(*names, @options, $OPT_OPTIONS_FIRST | $OPT_NO_SPACE);
  783.     $args = $cvsargs;
  784.  
  785.     # Put together the "cvs update" command.
  786.  
  787.     if ($buildDirs) {
  788.     $args .= "-d ";
  789.     }
  790.     if (! $recurse) {
  791.     $args .= "-l ";
  792.     }
  793.     if ($installOp) {
  794.     $buffer = "cvsexec -d $cvsroot $cvsCmdArgs ";
  795.     $installOp = 0;
  796.     } else {
  797.     $buffer = "cvs -d $cvsroot $cvsCmdArgs ";
  798.     }
  799.  
  800.     if ($#names < $[) {
  801.     push(@names, ".");
  802.     }
  803.     if (-f $names[0]) {
  804.     if ($lock) {
  805.         $status = &Lock("r","."); 
  806.         if ($status) {
  807.         return $status;
  808.         }
  809.     }
  810.     $tmp = "$buffer update $args @names";
  811.     printf("$tmp\n") if ($debug);
  812.     system($tmp);
  813.     $recurse = 0;
  814.     &Unpack(".") == 0 ||
  815.         return &Error(1, "Unpack of current directory failed.\n");
  816.     } else {
  817.     #
  818.     # Lock the modules.
  819.     #
  820.     if ($lock) {
  821.         $status = &Lock("r", @names); 
  822.         if ($status) {
  823.         return $status;
  824.         }
  825.     }
  826.     $pwd = $ENV{'PWD'};
  827. module: 
  828.     foreach $i (@names) {
  829.         $prune = 0;
  830.         &Chdir($i) == 0 || return 1; 
  831.         if (-e "SCVS/$argFile") {
  832.         local(@targs);
  833.         @targs = &ReadFile("SCVS/$argFile", 1);
  834.         if ($targs[1] =~ /(.*)-p(.*)/) {
  835.             $targs[1] = "$1 $2";
  836.             $prune = 1;
  837.         }
  838.         chop($targs[0]);
  839.         chop($targs[1]);
  840.         }
  841.         $tmp = "$buffer $targs[0] update $args $targs[1]";
  842.         printf("$tmp\n") if ($debug);
  843.         system($tmp);
  844.         if (&Unpack($i)) {
  845.         printf(STDERR "Unpack of $i failed.\n");
  846.         $status = 1;
  847.         }
  848.         if ($prune) {
  849.         if (&Prune($i)) {
  850.             printf(STDERR "Prune of $i failed.\n");
  851.             $status = 1;
  852.         }
  853.         }
  854.  
  855.         &Chdir($pwd) == 0 || return 1; 
  856.     }
  857.     }
  858.     return $status;
  859. }
  860.  
  861. #
  862. # Changed($path)
  863. #
  864. # Use the "cvs info" command to see if the contents of the current directory
  865. # or its subdirectories have been changed by the user.  The modified
  866. # parameter is set to 1 if they have been.
  867. #
  868. # Results: 0 if successful, 1 otherwise; 0 if not modified, 1 otherwise
  869. #
  870. # Side effects: 
  871. #
  872. sub Changed {
  873.     local($path) = shift;
  874.     local($modified) = 0;
  875.     local($status) = 0;
  876.     if (!-d "CVS.adm") {
  877.     return 0;
  878.     }
  879.     open(CHG, "cvs -d $cvsroot info |") ||
  880.     return &Error(1, "Can't do cvs info on $path: $!\n");
  881.     while (<CHG>) {
  882.     if (/^[MC]\s+(\S+)/) {
  883.         printf("$path/$1 has been modified\n");
  884.         $modified = 1;
  885.     } elsif(/^A\s+(\S+)/) {
  886.         printf("$path/$1 has been added\n");
  887.         $modified = 1;
  888.     } elsif(/^R\s+(\S+)/) {
  889.         printf("$path/$1 has been deleted\n");
  890.         $modified = 1;
  891.     }
  892.     }
  893.     close(CHG);
  894.     ($status, @results) = &AllSubdirs($path, "Changed");
  895.     if ($status) {
  896.     return $status;
  897.     }
  898.     while ($#results >= $[) {
  899.     local($substatus) = shift(@results);
  900.     local($submod) = shift(@results);
  901.     if ($substatus) {
  902.         $status = 1;
  903.     }
  904.     if ($submod) {
  905.         $modified = 1;
  906.     }
  907.     }
  908.     return ($status, $modified);
  909. }
  910.  
  911. #
  912. # DoneCmd(@modules)
  913. #
  914. # Process the "done" command.  The user is deleted from the list of users
  915. # for each module.  If the -d flag is specified then the snapshot is
  916. # deleted as well.  If the user has made changes to the snapshot the user
  917. # is warned before the "done" command is completed.
  918. #
  919. # Results: 0 if successful, 1 otherwise
  920. #
  921. # Side effects: 
  922. #
  923. sub DoneCmd {
  924.     local(@modules) = @_;
  925.     local($status) = 0;
  926.     local($i);
  927.     local($me) = getlogin;
  928.     local($pwd) = $ENV{'PWD'};
  929.     local($repos, $found);
  930.     local($delete);
  931.     local($modified);
  932.     local(@options) = (
  933.     "d", $OPT_TRUE, *delete, "Delete module",
  934.     );
  935.  
  936.     $recurse = 1;
  937.     undef($cvsargs);
  938.     &Opt_Parse(*modules, @options, $OPT_OPTIONS_FIRST); 
  939.     if ($#modules < $[) {
  940.     return &Error(1, "Done command requires a list of modules\n");
  941.     }
  942.     # Make sure all the modules are unlocked, then lock them.
  943.     $status = &Lock("r",@modules); 
  944.     if ($status) {
  945.     return $status;
  946.     }
  947. module:
  948.     foreach $i (@modules) {
  949.     $ok = 0;
  950.     if (! -d $i) {
  951.         printf("Directory $i not found.\n");
  952.         next module;
  953.     }
  954.     &Chdir($i) == 0 || return 1; 
  955.     ($status, $modified) = &Changed($i);
  956.     if ($status) {
  957.         printf(STDERR "Unable to determine if $i module has changed.\n");
  958.         $modified = 1;
  959.     }
  960.     if ($modified == 1) {
  961.         printf("Do you wish to continue? [y/n] ");
  962. prompt:
  963.         while(1) {
  964.         $answer = <STDIN>;
  965.         chop($answer);
  966.         last prompt if ($answer eq "y");
  967.         next module if ($answer eq "n");
  968.         printf("Please answer with \"y\" or \"n\": ");
  969.         }
  970.     } elsif ($modified == 1) {
  971.         next module;
  972.     }
  973.  
  974.     # Update the user file.
  975.     $repos = &Repository(".");
  976.     next module if (!defined($repos));
  977.     if (!open(DONE1, "$repos/$userFile")) {
  978.         printf("Module $i is not checked out\n");
  979.         next module;
  980.     }
  981.     if (!open(DONE2, ">$repos/$tmpfile")) {
  982.         printf("Can't open $repos/$tmpfile: $!\n");
  983.         $status = 1;
  984.         next module;
  985.     }
  986.     $me = getlogin;
  987.     $found = 0;
  988.     while (<DONE1>) {
  989.         if (/^$me\s+([\w\/\.]+)\s+(.*)/) {
  990.         if ($1 eq "$pwd/$i") {
  991.             $found = 1;
  992.             next;
  993.         }
  994.         }
  995.         print DONE2 $_;
  996.     }
  997.     close(DONE1);
  998.     close(DONE2);
  999.     if (!$found) {
  1000.         printf("Module $i is not checked out\n");
  1001.         next module;
  1002.     }
  1003.     if (!rename("$repos/$tmpfile", "$repos/$userFile")) {
  1004.         printf("Rename of $repos/$tmpfile to $repos/$userFile failed:$!\n");
  1005.         unlink("$repos/$tmpfile");
  1006.         next module;
  1007.     }
  1008.     $ok = 1;
  1009.     }
  1010.     continue {
  1011.     &Chdir($pwd) == 0 || return 1; 
  1012.     if ($ok && $delete) {
  1013.         system("rm -rf $i");
  1014.         if ($?) {
  1015.         printf("Delete of $i failed: $?\n");
  1016.         }
  1017.     }
  1018.     }
  1019.     return $status;
  1020. }
  1021.  
  1022. #
  1023. # AllSubdirs(path, routine, args)
  1024. #
  1025. # Call a routine for each subdirectory of the current directory. The
  1026. # current working directory is changed to the subdirectory before the 
  1027. # routine is called, and the path is modified to reflect this change.
  1028. # The path is passed to the routine when it is called. The routine is
  1029. # called for all subdirectories even if one returns an non-zero status,
  1030. # although this function will then return a non-zero status.
  1031. # Any additional arguments for the routine are passed after the path
  1032. # argument.
  1033. #
  1034. # Results: 0 if successful, 1 if the routine returned non-zero for any
  1035. #         of the subdirectories.
  1036. #
  1037. # Side effects: 
  1038. #
  1039. sub AllSubdirs {
  1040.     local($path) = shift;
  1041.     local($routine) = shift;
  1042.     local($pwd) = $ENV{'PWD'};
  1043.     local($substatus);
  1044.     local($dir);
  1045.     local(@results);
  1046.     local(@status);
  1047.     local(@subdirs);
  1048.  
  1049.     printf(STDERR "AllSubdirs of $routine on $pwd\n") if ($debug);
  1050.     opendir(THISDIR, ".") || 
  1051.     return &Error(1, "Opendir of $path failed: $!\n"); 
  1052.     @subdirs = grep((-d) && (!/^\./) && (! -l) && ($_ ne 'CVS.adm'), 
  1053.             readdir(THISDIR));
  1054.     print("AllSubdirs: @subdirs\n") if ($debug);
  1055.     close(THISDIR);
  1056.     print "@subdirs\n****\n" if ($debug); 
  1057.     foreach $dir (@subdirs) {
  1058.     printf("\t$dir\n") if ($debug);
  1059.     &Chdir($dir) == 0 || return 1; 
  1060.     push(@results, &$routine($path . "/$dir", @_));
  1061.     &Chdir($pwd) == 0 || ($status = 1); 
  1062.     }
  1063.     if (wantarray) {
  1064.     return ($status, @results);
  1065.     }
  1066.     if ($status) {
  1067.     return $status;
  1068.     }
  1069.     @status = grep("$_ != 0", @results);
  1070.     if ($#status >= $[) {
  1071.     return $status[0];
  1072.     }
  1073.     return 0;
  1074. }
  1075.  
  1076.  
  1077. #
  1078. # VerifyCurrent($path, *stale, *modified)
  1079. #
  1080. # Check the status of the files in the current directory and its 
  1081. # subdirectories to see if they are out of date.
  1082. #
  1083. # Results: 0 if successful, 1 otherwise;
  1084. #
  1085. # Side effects: 
  1086. #
  1087. sub VerifyCurrent {
  1088.     local($path) = shift;
  1089.     local(*stale) = shift;
  1090.     local(*modified) = shift;
  1091.     local($pwd) = $ENV{'PWD'};
  1092.     local($status) = 0;
  1093.     local($substatus) = 0;
  1094.     local($current) = 1;
  1095.     local($mod) = 0;
  1096.  
  1097.     printf("Verifying that $path is current\n") if ($debug);
  1098.     if (!-d "CVS.adm") {
  1099.     return 0;
  1100.     }
  1101.     open(CHK, "cvs -d $cvsroot info |") ||
  1102.     return &Error(1, "Can't get info for $path: $!\n");
  1103.     while(<CHK>) {
  1104.     if (/^U\s+(\S+)/) {
  1105.         printf("File $path/$1 is out of date or needs to be added.\n");
  1106.         $current = 0;
  1107.     } elsif (/^D\s+(\S+)/) {
  1108.         printf("File $path/$1 has been removed from the repository.\n");
  1109.         $current = 0;
  1110.     } elsif (/^C\s+(\S+)/) {
  1111.         printf("File $path/$1 is out of date.\n");
  1112.         $current = 0;
  1113.     } elsif (/^[MARC]/) {
  1114.         $mod = 1;
  1115.     } 
  1116.     }
  1117.     close(CHK);
  1118.     if (!$current) {
  1119.     printf("$path is not current\n") if ($debug);
  1120.     push(@stale, $path);
  1121.     }
  1122.     if ($mod) {
  1123.     printf("$path has been modified\n") if ($debug);
  1124.     push(@modified, $path);
  1125.     }
  1126.     if ($recurse) {
  1127.     $status = &AllSubdirs($path, "VerifyCurrent", *stale, *modified);
  1128.     }
  1129.     return $status;
  1130. }
  1131.  
  1132. #
  1133. # UpdateInstalled(@files)
  1134. #
  1135. # Update the installed copy of the sources.  This is done on commit.
  1136. # If @files is not specified then the entire directory and its subdirectories
  1137. # are updated.
  1138. #
  1139. # Results: 0 if successful, 1 otherwise
  1140. #
  1141. # Side effects: The installed sources are updated.
  1142. #
  1143. sub UpdateInstalled {
  1144.     local(@files) = @_;
  1145.     local($dir);
  1146.     local($pwd) = $ENV{'PWD'};
  1147.     local($saveArgs) = $cvsCmdArgs;
  1148.  
  1149.     printf(STDERR "UpdateInstalled\n") if ($debug);
  1150.     $cvsCmdArgs = "-r";
  1151.     $dir = &ReadFile("CVS.adm/Repository", 1);
  1152.     if (!defined($dir)) {
  1153.     return 1;
  1154.     }
  1155.     chop($dir);
  1156.     &Chdir("$installdir/$dir") == 0 || return 1;
  1157.     $installOp = 1;
  1158.     &UpdateCmd(0, "-Q", @files) == 0 || return 1;
  1159.     &Chdir("$pwd") == 0 || return 1;
  1160.     $cvsCmdArgs = $saveArgs;
  1161.     return 0;
  1162. }
  1163.  
  1164.  
  1165.  
  1166. #
  1167. # Commit
  1168. #
  1169. # Commit the current directory and its subdirectories.
  1170. #
  1171. # Results: 0 if successful, 1 otherwise
  1172. #
  1173. # Side effects: 
  1174. #
  1175. sub Commit {
  1176.     local($path) = shift;
  1177.     local($args) = shift;
  1178.     local($pwd) = $ENV{'PWD'};
  1179.     local($status) = 0;
  1180.     local($output);
  1181.     local($tail);
  1182.  
  1183.  
  1184.     printf(STDERR "CommitDir $path\n") if ($debug);
  1185.     if (!-d "CVS.adm") {
  1186.     return 0;
  1187.     }
  1188.     printf("$path:\n");
  1189.     $tail = substr($path, rindex($path, '/') + 1);
  1190.     #
  1191.     # Before we commit the SCVS links file we remove all the deleted links
  1192.     # from it.
  1193.     #
  1194.     if ($tail eq "SCVS") {
  1195.     if (open(CMTDIR1, "$linkFile")) {
  1196.         open(CMTDIR2, ">$tmpfile") ||
  1197.         return &Error(1, "Open of $path/$tmpfile failed: $!\n");
  1198.         while(<CMTDIR1>) {
  1199.         next if (/^[*]/);
  1200.         print CMTDIR2 $_;
  1201.         }
  1202.         close(CMTDIR1);
  1203.         close(CMTDIR2);
  1204.         if (!rename("$tmpfile", "$linkFile")) {
  1205.         printf("Rename of $tmpfile to $linkFile failed:$!\n");
  1206.         unlink("$tmpfile");
  1207.         return 1;
  1208.         }
  1209.         system("cvs -d $cvsroot $cvsCmdArgs ci -f -m scvs links");
  1210.     }
  1211.     }
  1212.     system("cvs -d $cvsroot $cvsCmdArgs ci -f -a $args");
  1213.     return $status;
  1214. }
  1215.  
  1216. #
  1217. # CommitCmd(@names)
  1218. #
  1219. # Commit any changes to the modules or files. 
  1220. # Otherwise all changed files in the current directory and any subdirectories
  1221. # are committed.  Before anything is committed it is checked that all
  1222. # files are up-to-date.  If they aren't, a message is printed and the
  1223. # commit is not done.
  1224. #
  1225. # Results: 0 if successful, 1 otherwise
  1226. #
  1227. # Side effects: 
  1228. #
  1229.  
  1230. sub CommitCmd {
  1231.     local(@names) = @_;
  1232.     local($pwd, $i);
  1233.     local($status) = 0;
  1234.     local($path);
  1235.     local(@stale, @modified);
  1236.     local($tmp);
  1237.     local($args);
  1238.     local(@options) = (
  1239.     "l", $OPT_FALSE, *recurse, "Don't recurse on subdirs",
  1240.     "f", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  1241.     "n", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  1242.     "m", $OPT_FUNC, "CvsOpt2", $OPT_NULL,
  1243.     "r", $OPT_FUNC, "CvsOpt2", $OPT_NULL,
  1244.     );
  1245.  
  1246.     $recurse = 1;
  1247.     undef($cvsargs);
  1248.     &Opt_Parse(*names, @options, $OPT_OPTIONS_FIRST | $OPT_NO_SPACE);
  1249.     $args = $cvsargs;
  1250.  
  1251.     if ($#names < $[) {
  1252.     push(@names, ".");
  1253.     }
  1254.     $args .= " -q";
  1255.     if (-f $names[0]) {
  1256.     $status = &Lock("w","."); 
  1257.     if ($status) {
  1258.         return $status;
  1259.     }
  1260.     $status = &VerifyCurrent(".", *stale, *modified);
  1261.     if ($status) {
  1262.         return $status;
  1263.     }
  1264.     if ($#stale >= $[) {
  1265.         printf("Update your sources using \"scvs update\".\n");
  1266.         return $status;
  1267.     }
  1268.     $tmp = "cvs -d $cvsroot $cvsCmdArgs ci -f $args @names";
  1269.     system($tmp);
  1270.     $status = &UpdateInstalled(@names);
  1271.     } else {
  1272.     $status = &Lock("w",@names); 
  1273.     if ($status) {
  1274.         return $status;
  1275.     }
  1276.     $pwd = $ENV{'PWD'};
  1277.  
  1278.     #
  1279.     # All the modules and their subdirectories must be up-to-date.
  1280.     #
  1281. module:
  1282.     foreach $i (@names) {
  1283.         &Chdir($i) == 0 || return 1; 
  1284.         $status = &VerifyCurrent($i, *stale, *modified);
  1285.         if ($status) {
  1286.         return $status;
  1287.         }
  1288.         &Chdir($pwd) == 0 || return 1; 
  1289.     }
  1290.     
  1291.     if ($#stale >= $[) {
  1292.         printf("Update your sources using \"scvs update\".\n");
  1293.         return $status;
  1294.     }
  1295.     
  1296.     #
  1297.     # Commit all directories that were modified.
  1298.     #
  1299.     foreach $i (@modified) {
  1300.         &Chdir($i) == 0 || return 1; 
  1301.         $status = &Commit($i, $args);
  1302.         last if ($status);
  1303.         if (defined($installdir)) {
  1304.         $status = &UpdateInstalled;
  1305.         last if ($status);
  1306.         }
  1307.         &Chdir($pwd) == 0 || return 1; 
  1308.     }
  1309.     }
  1310.     return $status;
  1311. }
  1312.  
  1313.  
  1314. #
  1315. # WhoCmd(@modules)
  1316. #
  1317. # Print the names of users who have the modules checked out.
  1318. #
  1319. # Results: 0 if successful, 1 otherwise
  1320. #
  1321. # Side effects: 
  1322. #
  1323.  
  1324. sub WhoCmd {
  1325.     local(@modules) = @_;
  1326.     local($pwd, $i);
  1327.     local($status) = 0;
  1328.     local($cvsdir, @who, $user, %users, $line);
  1329.  
  1330.     if (!defined(%modMap)) {
  1331.     &ModMap;
  1332.     }
  1333.     if ($#modules < $[) {
  1334.     push(@modules, ".");
  1335.     }
  1336.     $status = &Lock("r",@modules); 
  1337.     if ($status) {
  1338.     return $status;
  1339.     }
  1340.     $pwd = $ENV{'PWD'};
  1341.  
  1342. module:
  1343.     foreach $i (@modules) {
  1344.     if ($i eq ".") {
  1345.         $i = &GetModuleName;
  1346.         if (!defined($i)) {
  1347.         $status = 1;
  1348.         next module;
  1349.         }
  1350.     }
  1351.     if (!defined($modMap{$i})) {
  1352.         printf(STDERR "$i module does not exist.\n");
  1353.         $status = 1;
  1354.         next module;
  1355.     }
  1356.     $cvsdir = $cvsroot . "/" . $modMap{$i};
  1357.     @who = &ReadFile("$cvsdir/$userFile", 1);
  1358.     foreach $line (@who) {
  1359.         ($user) = split(' ', $line);
  1360.         $users{$user} = 1;
  1361.     }
  1362.     foreach $user (keys %users) {
  1363.         printf("$user\n");
  1364.     }
  1365.     }
  1366.     return $status;
  1367. }
  1368.  
  1369. #
  1370. # AddCmd(@names)
  1371. #
  1372. # Add a file, directory, or symbolic link to a directory.
  1373. #
  1374. # Results: 0 if successful, 1 otherwise
  1375. #
  1376. # Side effects: 
  1377. #
  1378.  
  1379. sub AddCmd {
  1380.     local(@names) = @_;
  1381.     local($i);
  1382.     local($status) = 0;
  1383.     local(%links);
  1384.     local($pwd) = $ENV{'PWD'};
  1385.     local($module);
  1386.     local($args);
  1387.     local(@options) = (
  1388.     "m", $OPT_FUNC, "CvsOpt2", $OPT_NULL,
  1389.     );
  1390.  
  1391.     undef($cvsargs);
  1392.     &Opt_Parse(*names, @options, $OPT_OPTIONS_FIRST | $OPT_NO_SPACE);
  1393.     $args = $cvsargs;
  1394.  
  1395.     if ($#names < $[) {
  1396.     return &Error(1, "Add command requires list of files\n");
  1397.     }
  1398.     $module = &GetModuleName;
  1399.     if (!defined($module)) {
  1400.     return 1;
  1401.     }
  1402. name:
  1403.     foreach $i (@names) {
  1404.     if (-l $i) {
  1405.         local($target) = readlink($i);
  1406.         if (!defined($target)) {
  1407.         printf("$i does not exist\n");
  1408.         $status = 1;
  1409.         next name;
  1410.         }
  1411.         if (open(ADD, "SCVS/$linkFile")) {
  1412.         while(<ADD>) {
  1413.             if (/^$i\s+(\S+)/) {
  1414.             if ($target ne $1) {
  1415.                 printf("Link $i already points to $1.\n");
  1416.             } else {
  1417.                 printf("Link $i already added.\n");
  1418.             }
  1419.             $status = 1;
  1420.             close(ADD);
  1421.             next name;
  1422.             }
  1423.         }
  1424.         close(ADD);
  1425.         } elsif (! -f "SCVS/$linkFile") {
  1426.         open(ADD, ">SCVS/$linkFile") ||
  1427.             return &Error(1, "Can't open SCVS/$linkFile: $!\n");
  1428.         printf(ADD 
  1429.         "# This file is used by scvs and contains symbolic link\n");
  1430.         printf(ADD 
  1431.         "# information.  Each line is of the form \"link target\"\n");
  1432.         printf(ADD "# \$Header\n");
  1433.         close(ADD);
  1434.         &Chdir("SCVS") == 0 || return 1; 
  1435.         printf("Adding $linkFile directory\n") if ($debug);
  1436.         system("cvs -d $cvsroot add -m \"sym links\" $linkFile");
  1437.         &Chdir($pwd) == 0 || return 1; 
  1438.         } else {
  1439.         return &Error(1, "Open of SCVS/$linkFile failed: $!\n");
  1440.         }
  1441.         $links{$i} = $target;
  1442.     } else {
  1443.         system("cvs -d $cvsroot $cvsCmdArgs add $args $i");
  1444.         if (-d $i) {
  1445.         # 
  1446.         # If we are adding a directory then we should create an
  1447.         # SCVS subdirectory in it.
  1448.         #
  1449.         if (! -d "$i/SCVS") {
  1450.             mkdir("$i/SCVS", 0770) ||
  1451.             return &Error(1, "Mkdir of $i/SCVS failed: $!\n");
  1452.             &Chdir("$i/SCVS") == 0 || return 1; 
  1453.             open(ADD, ">module") ||
  1454.             return &Error(1, "Open of $i/SCVS/module failed: $!\n");
  1455.             printf(ADD "$module\n");
  1456.             close(ADD);
  1457.             system("cvs -d $cvsroot add module");
  1458.             &Chdir($pwd) == 0 || return 1; 
  1459.         }
  1460.         }
  1461.     }
  1462.     if (defined(%links)) {
  1463.         open(ADD, ">>SCVS/$linkFile") ||
  1464.         return &Error(1, "Open of SCVS/$linkFile failed: $!\n");
  1465.         while (($i, $target) = each(%links)) {
  1466.         printf("Adding link $i -> $target\n") if ($debug);
  1467.         printf(ADD "%-24s %s\n", $i, $target);
  1468.         }
  1469.         close(ADD);
  1470.     }
  1471.     }
  1472.     return $status;
  1473. }
  1474. #
  1475. # RemoveCmd(@names)
  1476. #
  1477. # Removes a file, directory, or symbolic link from a directory.
  1478. #
  1479. # Results: 0 if successful, 1 otherwise
  1480. #
  1481. # Side effects: 
  1482. #
  1483.  
  1484. sub RemoveCmd {
  1485.     local(@names) = @_;
  1486.     local($i);
  1487.     local($status, %links, @delete) = 0;
  1488.  
  1489.     if ($#names < $[) {
  1490.     return &Error(1, "Remove command requires list of files\n");
  1491.     }
  1492.     if (open(RM, "SCVS/$linkFile")) {
  1493.     while(<RM>) {
  1494.         next if (/^#/);
  1495.         if (/^([^*]\S+)\s+(\S+)/) {
  1496.         printf("Found link $1 -> $2\n") if ($debug);
  1497.         $links{$1} = $2;
  1498.         }
  1499.     }
  1500.     close(RM);
  1501.     }
  1502. name:
  1503.     foreach $i (@names) {
  1504.     if (-e $i) {
  1505.         printf("$i still exists, moving to $i.old\n");
  1506.         if (!rename("$i", "$i.old")) {
  1507.         printf("Rename failed: $!\n");
  1508.         $status = 1;
  1509.         next name;
  1510.         }
  1511.     }
  1512.     if (defined($links{$i})) {
  1513.         printf("Putting $i on delete list\n") if ($debug);
  1514.         push(@delete, $i);
  1515.     } else {
  1516.         system("cvs -d $cvsroot $cvsCmdArgs remove $i");
  1517.     }
  1518.     }
  1519.     if ($#delete >= $[) {
  1520.     if (!open(RM1, "SCVS/$linkFile")) {
  1521.         printf("Can't open SCVS/$linkFile: $!\n");
  1522.         $status = 1;
  1523.         next name;
  1524.     }
  1525.     if (!open(RM2, ">$tmpfile")) {
  1526.         printf("Can't open $tmpfile: $!\n");
  1527.         $status = 1;
  1528.         next name;
  1529.     }
  1530. line:
  1531.     while (<RM1>) {
  1532.         if (/^([^#*]\S+)\s+(\S+)/) {
  1533.         for ($i = 0; $i <= $#delete; $i++) {
  1534.             if ($delete[$i] eq $1) {
  1535.             splice(@delete, $i, 1);
  1536.             print RM2 "*$_";
  1537.             next line;
  1538.             }
  1539.         }
  1540.         }
  1541.         print RM2 $_;
  1542.     }
  1543.     close(RM1);
  1544.     close(RM2);
  1545.     if (!rename("$tmpfile", "SCVS/$linkFile")) {
  1546.         printf("Rename of $tmpfile to SCVS/$linkFile failed:$!\n");
  1547.         unlink("$tmpfile");
  1548.         $status = 1;
  1549.     }
  1550.     }
  1551.     return $status;
  1552. }
  1553. #
  1554. # Info($path)
  1555. #
  1556. # Prints out status information for the current directory and recurses
  1557. # on subdirectories.
  1558. #
  1559. # Results: 0 if successful, 1 otherwise
  1560. #
  1561. # Side effects: 
  1562. #
  1563. sub Info {
  1564.     local($path) = shift;
  1565.     local($tail);
  1566.     local($diff) = 0;
  1567.     local($cat) = 0;
  1568.     local($i);
  1569.     local($pwd) = $ENV{'PWD'};
  1570.  
  1571.     if (!-d "CVS.adm") {
  1572.     return 0;
  1573.     }
  1574.     $tail = substr($path, rindex($path, '/') + 1);
  1575.     if ($tail eq "SCVS") {
  1576.     return 0;
  1577.     }
  1578.     system("cvs -d $cvsroot $cvsCmdArgs info");
  1579.     if (-d "SCVS") {
  1580.     &Chdir("SCVS") == 0 || return 1;
  1581.     open(INFO, "cvs -d $cvsroot info |") ||
  1582.         return &Error(1, "Can't do cvs info on $path: $!\n");
  1583.     while(<INFO>) {
  1584.         if (/^[UMC]\s+$linkFile/) {
  1585.         $diff = 1;
  1586.         last;
  1587.         } elsif (/^[AD]\s+$linkFile/) {
  1588.         $cat = 1;
  1589.         last;
  1590.         }
  1591.     }
  1592.     close(INFO);
  1593.     if ($diff) {
  1594.         local(%updated);
  1595.         open(INFO, "cvs -d $cvsroot diff $linkFile |") ||
  1596.         return &Error(1, "Can't do cvs diff on $path/$linkFile: $!\n");
  1597.         while(<INFO>) {
  1598.         if (/^>\s+([^*]\S+)/) {
  1599.             printf("A %s\@\n", $1);
  1600.         } elsif (/^>\s+[*](\S+)/) {
  1601.             printf("R %s\@\n", $1);
  1602.             delete $updated{$1};
  1603.         } elsif (/^<\s+([^*]\S+)/) {
  1604.             $updated{$1} = 1;
  1605.         } elsif (/^<\s+[*](\S+)/) {
  1606.             printf("D %s\@\n", $1);
  1607.         }
  1608.         }
  1609.         close(INFO);
  1610.         foreach $i (keys %updated) {
  1611.         printf("U %s\@\n", $i);
  1612.         }
  1613.     }
  1614.     if ($cat) {
  1615.         open(INFO, "$linkFile") ||
  1616.         return &Error(1, "Open of $linkFile failed: $!\n");
  1617.         while(<INFO>) {
  1618.         next if (/^#/);
  1619.         if (/^([^*]\S+)/) {
  1620.             printf("A %s\@\n", $1);
  1621.         } elsif (/^([*]\S+)/) {
  1622.             printf("R %s\@\n", $1);
  1623.         }
  1624.         }
  1625.         close(INFO);
  1626.     }
  1627.     &Chdir($pwd) == 0 || return 1;
  1628.     }
  1629.     if (($recurse) && ($#files < $[)) {
  1630.     $status = &AllSubdirs($path, "Info");
  1631.     }
  1632. }
  1633.  
  1634. #
  1635. # InfoCmd(@modules)
  1636. #
  1637. # Prints out status information for the given modules.
  1638. #
  1639. # Results: 0 if successful, 1 otherwise
  1640. #
  1641. # Side effects: 
  1642. #
  1643.  
  1644. sub InfoCmd {
  1645.     local(@modules) = @_;
  1646.     local($pwd, $i);
  1647.     local($status) = 0;
  1648.     local(@options) = ("l", $OPT_FALSE, *recurse, "Don't recurse on subdirs");
  1649.  
  1650.     $recurse = 1;
  1651.     undef($cvsargs);
  1652.     &Opt_Parse(*modules, @options, $OPT_OPTIONS_FIRST);
  1653.     print "@modules\n" if ($debug);
  1654.  
  1655.     if ($#modules < $[) {
  1656.     push(@modules, ".");
  1657.     }
  1658.     if (-f $modules[0]) {
  1659.     $status = &Lock("r","."); 
  1660.     if ($status) {
  1661.         return $status;
  1662.     }
  1663.     system("cvs -d $cvsroot $cvsCmdArgs info @modules");
  1664.     } else {
  1665.     $status = &Lock("r",@modules);
  1666.     if ($status) {
  1667.         return $status;
  1668.     }
  1669.     $pwd = $ENV{'PWD'};
  1670.     foreach $i (@modules) {
  1671.         printf("InfoCmd %i\n") if ($debug);
  1672.         &Chdir($i) == 0 || return 1; 
  1673.         $status = &Info($i);
  1674.         if ($status) {
  1675.         return $status;
  1676.         }
  1677.         &Chdir($pwd) == 0 || return 1; 
  1678.     }
  1679.     }
  1680.     return $status;
  1681. }
  1682.  
  1683. #
  1684. # DiffFile($path, $file, $args, $current)
  1685. #
  1686. # Prints out status information for the current directory and recurses
  1687. # on subdirectories.
  1688. #
  1689. # Results: 0 if successful, 1 otherwise
  1690. #
  1691. # Side effects: 
  1692. #
  1693. sub DiffFile {
  1694.     local($path) = shift;    # Current path.
  1695.     local($file) = shift;    # File to diff.
  1696.     local($args) = shift;    # args to cvs diff.
  1697.     local($current) = shift;    # Should we diff with current version.
  1698.     local($tail);
  1699.     local($pwd) = $ENV{'PWD'};
  1700.     local($status) = 0;
  1701.     local($version) = "";
  1702.     local($repository);
  1703.  
  1704.     if (!-d "CVS.adm") {
  1705.     return 0;
  1706.     }
  1707.     $repository = &Repository(".");
  1708.     if (!defined($repository)) {
  1709.     print("Repository not found\n") if ($debug);
  1710.     return 0;
  1711.     }
  1712.     printf("Repository is $repository\n") if ($debug);
  1713.     if (!-e "$repository/$file,v") {
  1714.     return 0;
  1715.     }
  1716.     if ($current) {
  1717.     open(DIFF, "cvs -d $cvsroot status $file |") ||
  1718.         return &Error(1, "Can't get status for $path/$file: $!\n");
  1719.     while(<DIFF>) {
  1720.         if (/^RCS:\s+(\S+)/) {
  1721.         $version = "-r $1";
  1722.         last;
  1723.         }
  1724.     }
  1725.     close(DIFF);
  1726.     }
  1727.     system("cvs -d $cvsroot $cvsCmdArgs diff $version $args $file");
  1728. }
  1729.  
  1730. #
  1731. # Diff($path, $args, $current)
  1732. #
  1733. # Prints out status information for the current directory and recurses
  1734. # on subdirectories.
  1735. #
  1736. # Results: 0 if successful, 1 otherwise
  1737. #
  1738. # Side effects: 
  1739. #
  1740. sub Diff {
  1741.     local($path) = shift;    # Current path.
  1742.     local($args) = shift;    # args to cvs diff.
  1743.     local($current) = shift;    # Should we diff with current version.
  1744.     local($tail);
  1745.     local($pwd) = $ENV{'PWD'};
  1746.     local($file);
  1747.     local($status) = 0;
  1748.  
  1749.     if (!-d "CVS.adm") {
  1750.     return 0;
  1751.     }
  1752.     $tail = substr($path, rindex($path, '/') + 1);
  1753.     if ($tail eq "SCVS") {
  1754.     return 0;
  1755.     }
  1756.     opendir(THISDIR, ".") || return &Error(1, "Opendir of $path failed: $!\n");
  1757.     foreach $file (grep(-f, readdir(THISDIR))) {
  1758.     printf(STDERR "$file\n") if ($debug);
  1759.     $status = &DiffFile($path, $file, $args, $current);
  1760.     if ($status) {
  1761.         return $status;
  1762.     }
  1763.     }
  1764.     if ($recurse) {
  1765.     $status = &AllSubdirs($path, "Diff", $args, $current);
  1766.     }
  1767. }
  1768.  
  1769.  
  1770.  
  1771. #
  1772. # DiffCmd(@modules)
  1773. #
  1774. # Does an rcsdiff on the modules or directories
  1775. #
  1776. # Results: 0 if successful, 1 otherwise
  1777. #
  1778. # Side effects: 
  1779. #
  1780.  
  1781. sub DiffCmd {
  1782.     local(@modules) = @_;
  1783.     local($pwd, $i);
  1784.     local($status) = 0;
  1785.     local($current) = 0;
  1786.     local(@options) = (
  1787.     "R", $OPT_TRUE, *current, "Diff with current version",
  1788.     "l", $OPT_FALSE, *recurse, "Recurse on subdirectories",
  1789.     "b", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  1790.     "i", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  1791.     "w", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  1792.     "t", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  1793.     "c", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  1794.     "e", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  1795.     "f", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  1796.     "h", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  1797.     "n", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  1798.     "r", $OPT_FUNC, "CvsOpt2", $OPT_NULL,
  1799.     );
  1800.  
  1801.     $recurse = 1;
  1802.     undef($cvsargs);
  1803.     &Opt_Parse(*modules, @options, $OPT_OPTIONS_FIRST | $OPT_NO_SPACE);
  1804.     print "@modules\n" if ($debug);
  1805.     if ($#modules < $[) {
  1806.     push(@modules, ".");
  1807.     }
  1808.     if (-f $modules[0]) {
  1809.     $status = &Lock("r","."); 
  1810.     if ($status) {
  1811.         return $status;
  1812.     }
  1813.     foreach $i (@modules) {
  1814.         &DiffFile(".", $i, $cvsargs, $current);
  1815.     }
  1816.     } else {
  1817.     $status = &Lock("r",@modules);
  1818.     if ($status) {
  1819.         return $status;
  1820.     }
  1821.     $pwd = $ENV{'PWD'};
  1822.  
  1823.     foreach $i (@modules) {
  1824.         printf("DiffCmd $i\n") if ($debug);
  1825.         &Chdir($i) == 0 || return 1; 
  1826.         $status = &Diff($i, $cvsargs, $current);
  1827.         if ($status) {
  1828.         return $status;
  1829.         }
  1830.         &Chdir($pwd) == 0 || return 1; 
  1831.     }
  1832.     }
  1833.     return $status;
  1834. }
  1835.  
  1836. #
  1837. # Cvs($path, $command)
  1838. #
  1839. # Run a cvs command in the current directory and its subdirectories.
  1840. # Any output from the command is printed.  The command is not executed
  1841. # in any "SCVS" subdirectories.
  1842. #
  1843. # Results: 0 if successful, 1 otherwise
  1844. #
  1845. # Side effects: 
  1846. #
  1847. sub Cvs {
  1848.     local($path) = shift;
  1849.     local($command) = shift;
  1850.     local($pwd) = $ENV{'PWD'};
  1851.     local($status) = 0;
  1852.     local($output, $tail);
  1853.  
  1854.     if (!-d "CVS.adm") {
  1855.     return 0;
  1856.     }
  1857.     $tail = substr($path, rindex($path, '/') + 1);
  1858.     if ($tail eq "SCVS") {
  1859.     return 0;
  1860.     }
  1861.     printf("%s\n", $path);
  1862.     system("cvs -d $cvsroot $cvsCmdArgs $command");
  1863.     if ($recurse) {
  1864.     $status = &AllSubdirs($path, "Cvs", $command);
  1865.     }
  1866.     return $status;
  1867. }
  1868.  
  1869.  
  1870. #
  1871. # CvsCmd($command, @modules)
  1872. #
  1873. # Runs a cvs command on each module and its subdirectories.
  1874. # Any output from the command is printed.
  1875. #
  1876. # Results: 0 if successful, 1 otherwise
  1877. #
  1878. # Side effects: 
  1879. #
  1880.  
  1881. sub CvsCmd {
  1882.     local($command) = shift;
  1883.     local(@modules) = @_;
  1884.     local($i, @args);
  1885.     local($status) = 0;
  1886.     local($path);
  1887.     local($pwd) = $ENV{'PWD'};
  1888.     local(@options) = (
  1889.     "l", $OPT_FALSE, *recurse, "Don't recurse on subdirs",
  1890.     "L", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  1891.     "R", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  1892.     "h", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  1893.     "t", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  1894.     "b", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  1895.     "d", $OPT_FUNC, "CvsOpt2", $OPT_NULL,
  1896.     "l", $OPT_FUNC, "CvsOpt2", $OPT_NULL,
  1897.     "r", $OPT_FUNC, "CvsOpt2", $OPT_NULL,
  1898.     "s", $OPT_FUNC, "CvsOpt2", $OPT_NULL,
  1899.     "w", $OPT_FUNC, "CvsOpt2", $OPT_NULL,
  1900.     );
  1901.  
  1902.  
  1903.     $recurse = 1;
  1904.     undef($cvsargs);
  1905.     &Opt_Parse(*modules, @options, $OPT_OPTIONS_FIRST | $OPT_NO_SPACE);
  1906.  
  1907.     if ($#modules < $[) {
  1908.     push(@modules, ".");
  1909.     }
  1910.     if (-f $modules[0]) {
  1911.     $status = &Lock("r","."); 
  1912.     if ($status) {
  1913.         return $status;
  1914.     }
  1915.     $tmp = "cvs -d $cvsroot $cvsCmdArgs $command $cvsargs @modules";
  1916.     print "$tmp\n" if ($debug);
  1917.     system($tmp);
  1918.     } else {
  1919.     $status = &Lock("r", @modules); 
  1920.     if ($status) {
  1921.         return $status;
  1922.     }
  1923. module: 
  1924.     foreach $i (@modules) {
  1925.         &Chdir($i) == 0 || return 1; 
  1926.         $status = &Cvs($i, $command);
  1927.         &Chdir($pwd) == 0 || return 1; 
  1928.     }
  1929.     }
  1930.     return $status;
  1931. }
  1932.  
  1933.  
  1934.  
  1935. #
  1936. # Exit
  1937. #
  1938. # Exit with a status of 1.
  1939. #
  1940. # Results: Doesn't return
  1941. #
  1942. # Side effects: The script exits.
  1943. #
  1944.  
  1945.  
  1946. sub Exit {
  1947.     exit(1);
  1948. }
  1949.  
  1950.  
  1951. #
  1952. # Usage(@optionArray)
  1953. #
  1954. # Print out help information.
  1955. #
  1956. # Results: None
  1957. #
  1958. # Side effects: Stuff is printed
  1959. #
  1960. sub Usage {
  1961.     local(@options) = @_;
  1962.     local(%info) = (("unpack", "Create symbolic links"),
  1963.             ("checkout", "Checkout a copy of a module"),
  1964.             ("unlock", "Unlock a module"),
  1965.             ("lock", "Lock a module"),
  1966.             ("update", "Update a copy of a module"),
  1967.             ("done", "User is done with a module"),
  1968.             ("commit", "Commit changes to a module"),
  1969.             ("who", "Print a list of users with copies of a module"),
  1970.             ("diff", "Do rcsdiff on files you have changed"),
  1971.             ("status", "Print out rcs status of files"),
  1972.             ("log", "Print rcs log of files"),
  1973.             ("join", "Merge in new vendor release"),
  1974.             ("patch", "Create a patch file"),
  1975.             ("tag", "Tag a version"));
  1976.  
  1977.     &Opt_PrintUsage(@options);
  1978.     printf("\nValid commands are:\n");
  1979.     foreach $i sort ("unpack", "checkout", "unlock", "lock", "update", 
  1980.             "done", "commit", "who", "diff", "status", "log",
  1981.             @cvsCmds) {
  1982.     printf("\t$i\t%s\n", $info{$i});
  1983.     }
  1984. }
  1985.  
  1986. #
  1987. # Error($status, @args)
  1988. #
  1989. # Prints @args to STDERR, and returns $status
  1990. #
  1991. # Results: $status
  1992. #
  1993. # Side effects: Stuff is printed
  1994. #
  1995. sub Error {
  1996.     local($status) = shift;
  1997.     if ($#_ >= $[) {
  1998.     printf(STDERR @_);
  1999.     }
  2000.     return $status;
  2001. }
  2002.  
  2003. #
  2004. # ReadFile($file, $ignoreComments)
  2005. #
  2006. # Reads the contents of the given file.  If $ignoreComments is non-zero
  2007. # then any line beginning with '#' is ignored.  
  2008. #
  2009. # Results: An array containing each line of the file.  If a scalar is
  2010. #     wanted then only the first line is returned.
  2011. #
  2012. # Side effects: 
  2013. #
  2014. sub ReadFile {
  2015.     local($file) = shift;
  2016.     local($ignoreComments) = shift; 
  2017.     local(@contents);
  2018.     open(READ, "$file") ||
  2019.     return &Error(undef, "Open of $file failed: $!\n");
  2020.     if ($ignoreComments) {
  2021.     @contents = grep(!/^#/, <READ>);
  2022.     } else {
  2023.     @contents = <READ>;
  2024.     }
  2025.     close(READ);
  2026.     if ($#contents < $[) {
  2027.     return undef;
  2028.     }
  2029.     if (wantarray) {
  2030.     return @contents;
  2031.     } 
  2032.     return($contents[0]);
  2033. }
  2034.  
  2035. #
  2036. # WriteFile($file, @args)
  2037. #
  2038. # Writes @args to $file.  The file is created if it doesn't exist.
  2039. #
  2040. # Results: 0 if successful, 1 otherwise
  2041. #
  2042. # Side effects:  $file may be created, and it is written.
  2043. #
  2044. sub WriteFile {
  2045.     local($file) = shift;
  2046.     open(WRITE, ">$file") ||
  2047.     return &Error(1, "Open of $file failed: $!\n");
  2048.     print WRITE @_;
  2049.     close(WRITE);
  2050.     return 0;
  2051. }
  2052.  
  2053.  
  2054. #
  2055. # GetModuleName
  2056. #
  2057. # Gets the module name from the name in CVS.adm/Repository and %dirMap.
  2058. #
  2059. # Results: The module name.
  2060. #
  2061. # Side effects:  
  2062. #
  2063. sub GetModuleName {
  2064.     local($dir);
  2065.     local($index);
  2066.     if (!defined(%dirMap)) {
  2067.     &ModMap;
  2068.     }
  2069.     $dir = &ReadFile("CVS.adm/Repository");
  2070.     chop($dir);
  2071.     printf("$dir\n") if ($debug);
  2072.     if (!defined($dir)) {
  2073.     return undef;
  2074.     }
  2075.     while($dir ne "") {
  2076.     if (defined($dirMap{$dir})) {
  2077.         printf("Module $dirMap{$dir}\n") if ($debug);
  2078.         return $dirMap{$dir};
  2079.     }
  2080.     $index = rindex($dir, '/');
  2081.     if ($index < $[) {
  2082.         last;
  2083.         return $dir;
  2084.     }
  2085.     $dir = substr($dir, 0, $index);
  2086.     }
  2087.     return $dir;
  2088. }
  2089.  
  2090.  
  2091. #
  2092. # Chdir($dir)
  2093. #
  2094. # Changes the current working directory to $dir.  If the command fails
  2095. # an error message is printed. 
  2096. #
  2097. # Results: 0 if successful, 1 otherwise
  2098. #
  2099. # Side effects:  The current working directory is changed, and $ENV{'PWD'}
  2100. #     set to the new working directory.
  2101. #
  2102. sub Chdir {
  2103.     &chdir($_[0]) ||
  2104.     return &Error(1, "Chdir to %s from %s failed: $!\n", 
  2105.         $_[0], $ENV{'PWD'});
  2106.     return 0;
  2107. }
  2108.  
  2109. #
  2110. # ModMap
  2111. #
  2112. # Creates a mapping of module name to its subdirectory in the repository,
  2113. # and a mapping from the subdirectory to the module name.
  2114. #
  2115. # Results: 0 if successful, 1 otherwise
  2116. #
  2117. # Side effects:  The %modMap and %dirMap are filled in.
  2118. #
  2119.  
  2120. sub ModMap {
  2121.     local($module, $dir);
  2122.     open(MOD, "cvs -d $cvsroot co -c |") ||
  2123.     return &Error(1, "Can't do \"cvs co -c\"\n");
  2124.     undef %modMap;
  2125.     while(<MOD>) {
  2126.     if (/^(\S+)\s+(\S+)/) {
  2127.         $modMap{$1} = $2;
  2128.         $dirMap{$2} = $1;
  2129.     }
  2130.     }
  2131.     close(MOD);
  2132. }
  2133.  
  2134. #
  2135. # Main
  2136. #
  2137. #
  2138. $SIG{'INT'} = Exit;
  2139. &initpwd;
  2140. $tmpfile = "#SCVS.$$";
  2141. $status = 0;
  2142. if (&Config) {
  2143.     exit(1);
  2144. }
  2145. $command = shift;
  2146. if (!defined($command)) {
  2147.     &Usage(@options);
  2148.     exit(1);
  2149. }
  2150. printf("$command: %s\n", join(' ', @ARGV)) if ($debug);
  2151.  
  2152. if (($command eq "pack") || ($command eq "unpack")) {
  2153.     local(@options) = ("l", $OPT_FALSE, *recurse, "Recurse on subdirectories");
  2154.     &Opt_Parse(*ARGV, @options, 0);
  2155.     $status = &PackCmd($command, @ARGV);
  2156. } elsif (($command eq "checkout") || ($command eq "co")) {
  2157.     $command = "checkout";
  2158.     $status = &Checkout(@ARGV);
  2159. } elsif ($command eq "unlock") {
  2160.     $status = &UnlockCmd(@ARGV);
  2161. } elsif ($command eq "lock") {
  2162.     $status = &LockCmd(@ARGV);
  2163.     undef(@locks);
  2164. } elsif ($command eq "update") {
  2165.     $status = &UpdateCmd(1, @ARGV);
  2166. } elsif ($command eq "done") {
  2167.     $status = &DoneCmd(@ARGV);
  2168. } elsif (($command eq "commit") || ($command eq "ci")) {
  2169.     $status = &CommitCmd(@ARGV);
  2170. } elsif ($command eq "who") {
  2171.     $status = &WhoCmd(@ARGV);
  2172. } elsif ($command eq "add") {
  2173.     $status = &AddCmd(@ARGV);
  2174. } elsif ($command eq "remove") {
  2175.     $status = &RemoveCmd(@ARGV);
  2176. } elsif ($command eq "info") {
  2177.     $status = &InfoCmd(@ARGV);
  2178. } elsif ($command eq "diff") {
  2179.     $status = &DiffCmd(@ARGV);
  2180. } elsif (($command eq "status") || ($command eq "log")) {
  2181.     $status = &CvsCmd($command, @ARGV);
  2182. } elsif (grep($command eq $_, @cvsCmds)) {
  2183.     system("cvs -d $cvsroot $cvsCmdArgs $command @ARGV");
  2184.     $status = 0;
  2185. } else {
  2186.     printf("Bad command: $command\n");
  2187.     &Usage(@options);
  2188.     exit(1);
  2189. }
  2190.  
  2191. # Unlock any modules we may have locked.
  2192.  
  2193. if ($#locks >= $[) {
  2194.     &Unlock(0, @locks);
  2195. }
  2196. if ($status) {
  2197.     printf("$command failed\n");
  2198. }
  2199. exit($status);
  2200.